Fritz: All Fritz/All Fritz.zip/All Fritz/FILES/PROGASIC/BASFILES.LZH/MSKINPUT.BAS

BASIC Source File | 1988-09-10 | 6KB | 285 lines

'$INCLUDE:'QBTOOLS.INC'
'' '$INCLUDE: 'qbtools2.inc'

  SUB MaskInput (Allowup%, Allowpu%, Allowdn%, Allowpd%, Allowrt%, Allowtb%, Allowes%, il%, St$, Xc%, Yc%, fc%, Bc%, UpperCaseFlag%, ExitKey%, Mask$) STATIC

        CONST MASKVALUES = "()-/\[]{}:<>.=+;,?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz "

        InsStatus% = 0                '  Insert flag

        IF LEN(St$) > il% THEN        '  String is already too long
            St$ = MID$(St$, 1, il%)    '  Make it the right size
        END IF

        IF LEN(St$) < il% THEN        '  MUST make it equal to BLANKS
            St$ = St$ + STRING$(il% - LEN(St$), 32)
        END IF

        IF LEN(Mask$) <> il% THEN
            ExitKey% = 0
            EXIT SUB
        END IF

        InChar% = 0

        FOR j% = 1 TO il%
            InChar% = InChar% + ABS(INSTR(MASKVALUES, MID$(Mask$, j%, 1)) > 0)
        NEXT j%

        IF InChar% = il% THEN
            EXIT SUB
        END IF
        FOR j% = 1 TO il%
            ch$ = MID$(Mask$, j%, 1)
            SELECT CASE ch$
                CASE "(", ")", "-", "/", "\", "[", "]", "{", "}", ":", "<", ">", ".", "=", "+", ";", ",", "?", "A" TO "Z", "a" TO "z", " "
                    MID$(St$, j%, 1) = ch$
                CASE ELSE
            END SELECT
        NEXT j%

        MaskBackup$ = St$

        Xoff% = 1                     '  X-co-ordinate offset
        Attr% = Attributes%(fc%, Bc%, 0, 0)
        ExitKey% = 0
        ColorPrint St$, Yc%, Xc%, Attr%

        DO                            '  Until there's an exit

            DO
                IF INSTR(MASKVALUES, MID$(Mask$, Xoff%, 1)) THEN
                    Xoff% = Xoff% + 1
                ELSE
                    EXIT DO
                END IF

                IF Xoff% > il% THEN
                    Xoff% = il%

                    DO
                        IF INSTR(MASKVALUES, MID$(Mask$, Xoff%, 1)) THEN
                            Xoff% = Xoff% - 1
                        ELSE
                            EXIT DO
                        END IF
                    LOOP

                END IF

            LOOP

            IF Xoff% > il% THEN        '  Cursor positioner too long
                Xoff% = il%
            END IF

            IF Xoff% < 1 THEN
                Xoff% = 1
            END IF

            ColorPrint St$, Yc%, Xc%, Attr%

            IF InsStatus% = 1 THEN        '  Insert is on
                LOCATE Yc%, Xc% + Xoff% - 1, 1, 0, 15
            ELSE
                LOCATE Yc%, Xc% + Xoff% - 1, 1, 7, 7
            END IF

            w$ = ""                    '  Wait until there's a character
            WHILE w$ = ""
                w$ = INKEY$
            WEND
            LOCATE , , 0

            IF LEN(w$) = 1 THEN        '  Normal character

                Test$ = MID$(Mask$, Xoff%, 1)

                ch% = ASC(w$)

                    IF ch% = 13 THEN
                        IF Allowrt% = 1 THEN '  Yes, return is ok
                            ExitKey% = 5
                            EXIT DO
                        END IF
                    END IF

                    IF ch% = 9 THEN
                        IF Allowtb% = 1 THEN '  Yes, TAB is ok
                            ExitKey% = 6
                            EXIT DO
                        END IF
                    END IF

                    IF ch% = 27 THEN
                        IF Allowes% = 1 THEN '  Yes, ESC is ok
                            ExitKey% = 7
                            EXIT DO
                        END IF
                    END IF
                IF Test$ >= "0" AND Test$ <= "9" THEN
                    IF w$ <= Test$ THEN
                        ch% = ASC(w$)
                    ELSE
                        ch% = 0
                    END IF
                END IF

                IF Test$ = "&" THEN
                    IF UCASE$(w$) >= "A" AND UCASE$(w$) <= "Z" OR w$ = " " THEN
                        ch% = ASC(w$)
                    ELSE
                        ch% = 0
                    END IF
                END IF

                SELECT CASE ch%

                    CASE 32 TO 126       '  Normal displayable char
                        IF UpperCaseFlag% = 1 THEN  '  Make it upper
                            w$ = UCASE$(w$)
                            ch% = ASC(w$)
                        END IF

                        IF UpperCaseFlag% = 2 THEN  '  Make it lower
                            w$ = LCASE$(w$)
                            ch% = ASC(w$)
                        END IF

                        MID$(St$, Xoff%, 1) = CHR$(ch%)
                        Xoff% = Xoff% + 1

                    CASE 8, 127          '  Back space
                        IF Xoff% > 1 THEN
                            Xoff% = Xoff% - 1
                            IF INSTR(MASKVALUES, MID$(Mask$, Xoff%, 1)) = 0 THEN
                                MID$(St$, Xoff%, 1) = " "
                            END IF

                            DO
                                IF Xoff% > 0 THEN
                                    IF INSTR(MASKVALUES, MID$(Mask$, Xoff%, 1)) THEN
                                        Xoff% = Xoff% - 1
                                    ELSE
                                        MID$(St$, Xoff%, 1) = " "
                                        EXIT DO
                                    END IF
                                ELSE
                                    EXIT DO
                                END IF
                            LOOP

                            IF Xoff% = 0 THEN
                                DO
                                    Xoff% = Xoff% + 1
                                    IF INSTR(MASKVALUES, MID$(Mask$, Xoff%, 1)) = 0 THEN
                                        EXIT DO
                                    ELSE
                                        IF Xoff% = il% THEN
                                            PRINT
                                            PRINT "Illegal Mask"
                                            PRINT
                                            END
                                        END IF
                                    END IF
                                LOOP
                            END IF
                        END IF


                        CASE ELSE
                    END SELECT

                    ELSE
                        ch% = ASC(MID$(w$, 2))  '  Extended character
                        SELECT CASE ch%

                            CASE 75              '  Left arrow

                                IF Xoff% > 1 THEN
                                    Xoff% = Xoff% - 1

                                DO
                                    IF Xoff% > 0 THEN
                                        IF INSTR(MASKVALUES, MID$(Mask$, Xoff%, 1)) THEN
                                            Xoff% = Xoff% - 1
                                        ELSE
                                            EXIT DO
                                        END IF
                                    ELSE
                                        EXIT DO
                                    END IF
                                LOOP

                                IF Xoff% = 0 THEN
                                    DO
                                        Xoff% = Xoff% + 1
                                        IF INSTR(MASKVALUES, MID$(Mask$, Xoff%, 1)) = 0 THEN
                                            EXIT DO
                                        ELSE
                                            IF Xoff% = il% THEN
                                                PRINT
                                                PRINT "Illegal Mask"
                                                PRINT
                                                END
                                            END IF
                                        END IF
                                    LOOP
                                END IF
                            END IF



                            CASE 77              '  Right arrow
                                Xoff% = Xoff% + 1

                            CASE 71              '  Home
                                Xoff% = 1

                            CASE 79              '  End
                                Xoff% = il%

                            CASE 82              '  Insert
                                InsStatus% = 1 - InsStatus%

                            CASE 83              '  Delete
                                IF INSTR(MASKVALUES, MID$(Mask$, Xoff%, 1)) = 0 THEN
                                    MID$(St$, Xoff%, 1) = " "
                                END IF

                            CASE 72              '  Up arrow
                                IF Allowup% = 1 THEN '  Yes, UP is ok
                                    ExitKey% = 1
                                    EXIT DO
                                END IF

                            CASE 73              '  Page up
                                IF Allowpu% = 1 THEN '  Yes, PAGE UP is ok
                                    ExitKey% = 2
                                    EXIT DO
                                END IF

                            CASE 81              '  Page down
                                IF Allowpd% = 1 THEN '  Yes, PAGE DOWN is ok
                                    ExitKey% = 4
                                    EXIT DO
                                END IF

                            CASE 80              '  Down arrow
                                IF Allowdn% = 1 THEN '  Yes, DOWN is ok
                                    ExitKey% = 3
                                    EXIT DO
                                END IF

                            CASE 32              '  ALT+D (Delete)
                                St$ = MaskBackup$
                                Xoff% = 1

                            CASE ELSE
                        END SELECT
                    END IF
                LOOP WHILE ExitKey% = 0

            END SUB